home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / MAILPACK.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  13KB  |  421 lines
  1. UNIT MailPack;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Mail packer/router                            Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32;
  16.  
  17. PROCEDURE PerformPacking(CONST Sched:BYTE);
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES Dos, OpString, OpDos, OpDate, OpRoot,
  22.      Globals, PoPTypes, MailScan, NetFile, MailUtil, LogFile, StrUtil,
  23.      FileUtil, Util, OutUtil, Send2Utl, OpusMsg;
  24.  
  25. PROCEDURE PerformPacking(CONST Sched: Byte);
  26. VAR
  27.   Schedule     : TSchedule;
  28.   SchedFile    : TNetFile;
  29.   PntSr, DirSr,
  30.   sr           : SEARCHREC;
  31.   io, GlobZone : INTEGER;
  32.   p, ZoneOut   : PathStr;
  33.   Dest, Via    : TFidoAddress;
  34.  
  35.   PROCEDURE FindDestNode(FName: PathStr; VAR Dest, Via: TFidoAddress);
  36.   VAR
  37.     RightSched:LONGINT;
  38.     ch:CHAR;
  39.     Num,i:BYTE;
  40.     Tab:SendToTabType;
  41.     pmh:TPktHeader;
  42.     f : TNetFile;
  43.  
  44.     FUNCTION AllCmpAdr(CONST a1,a2:TFidoAddress):BOOLEAN;
  45.     BEGIN
  46.       AllCmpAdr:=((a1.Zone =a2.Zone ) OR (a2.Zone=-1)) AND
  47.                  ((a1.Net  =a2.Net  ) OR (a2.Net =-1)) AND
  48.                  ((a1.Node =a2.Node ) OR (a2.Node=-1)) AND
  49.                  ((a1.Point=a2.Point) OR (a2.Point=-1));
  50.     END;
  51.  
  52.     FUNCTION AllCmpAdrPoint(CONST a1,a2:TFidoAddress):BOOLEAN;
  53.     BEGIN
  54.       AllCmpAdrPoint:=((a1.Zone =a2.Zone ) OR (a2.Zone=-1)) AND
  55.                       ((a1.Net  =a2.Net  ) OR (a2.Net =-1)) AND
  56.                       ((a1.Node =a2.Node ) OR (a2.Node=-1)) AND
  57.                       ((a1.Point<>0) AND (a2.Point=0));
  58.     END;
  59.  
  60.   BEGIN
  61.     f.Open(FName,SizeOf(TPktHeader),FALSE);
  62.     f.Read(pmh,NoKeep,Wait);
  63.     f.Close;
  64.     GetPktHeadInfo(Pmh,Dest,Via);
  65.     Dest:=Via;
  66.     SchedFile.SEEK(0);
  67.     WHILE (NOT SchedFile.EOF) DO
  68.     BEGIN
  69.       SchedFile.Read(Schedule,nokeep,wait);
  70.       IF (Schedule.Action IN [2,3]) AND ((Schedule.Number=0) OR (Schedule.Number=Sched)) THEN
  71.       BEGIN
  72.         ReadSendTo(Schedule.Adr,Tab,Num);
  73.         FOR i:=1 TO Num DO
  74.           IF AllCmpAdr(Via,Tab[i]) OR AllCmpAdrPoint(Via,Tab[i]) THEN
  75.           BEGIN
  76.             CASE Schedule.Action OF
  77.               2 : Via:=Tab[1];
  78.               3 : Via:=Tab[i];
  79.             END;
  80.             IF via.zone=-1 THEN Via.Zone:=Dest.Zone;
  81.             IF via.Net=-1 THEN Via.Net:=Dest.Net;
  82.             IF via.node=-1 THEN Via.Node:=Dest.node;
  83.             IF via.Point=-1 THEN Via.Point:=Dest.Point;
  84.             EXIT;
  85.           END;
  86.       END;
  87.     END;
  88.   END;
  89.  
  90.   PROCEDURE PackIt(CONST FName: PathStr; CONST Dest, Via: TFidoAddress);
  91.   VAR
  92.     Flag:BOOLEAN;
  93.     DestBusyFile,ViaBusyFile:FILE;
  94.     ArcName,OldDir,NewPkt:PathStr;
  95.     ch : Char;
  96.     an : Byte;
  97.  
  98.     FUNCTION CurrentBundle(CONST Adr: TFidoAddress): PathStr;
  99.     VAR
  100.       NewAdr:TFidoAddress;
  101.       s,ss:PathStr;
  102.       Ch:CHAR;
  103.       sr:SEARCHREC;
  104.  
  105.       PROCEDURE EraseTruncatedBundles(CONST s: PathStr);
  106.       VAR
  107.         i,j:BYTE;
  108.         sr:SearchRec;
  109.         ss,sss:PathStr;
  110.       BEGIN
  111.         FOR j:=0 TO 6 DO
  112.         BEGIN
  113.           ss:=COPY(s,1,LENGTH(s)-3)+COPY(DayString[DayType(j)],1,2)+'?';
  114.           FINDFIRST(ss,Archive,sr);
  115.           WHILE DOSERROR=0 DO
  116.           BEGIN
  117.             IF sr.size=0 THEN
  118.             BEGIN
  119.               sss:=JustPathName(ss)+'\'+sr.name;
  120.               IF DeleteFile(sss) THEN
  121.                 AddLog('#','Deleting old truncated '+sr.name);
  122.             END;
  123.             FINDNEXT(sr);
  124.           END;
  125.           FindClose(sr);
  126.         END;
  127.       END;
  128.  
  129.     BEGIN
  130.       ss:='';
  131.       NewAdr.Zone:=Adr.Zone;
  132.       NewAdr.Net:=Cfg.Addresses[Cfg.MainAdrNum].Net-Adr.Net;
  133.       NewAdr.Node:=Cfg.Addresses[Cfg.MainAdrNum].Node-Adr.Node;
  134.       NewAdr.Point:=Adr.Point;
  135.       s:=HoldAreaPath(Adr,TRUE);
  136.       IF Adr.Point=0 THEN
  137.         s:=s+Address(NewAdr.Net,NewAdr.Node)
  138.       ELSE
  139.         s:=s+Address(0,Adr.point);
  140.       IF Cfg.MailScanner.OldExt THEN s:=s+'MO' ELSE
  141.         s:=s+'.'+COPY(TodayString('WWW'),1,2);
  142.       s:=s+'?';
  143.       ch:=' ';
  144.       FINDFIRST(s,Archive,sr);
  145.       WHILE DOSERROR=0 DO
  146.       BEGIN
  147.         IF sr.size>0 THEN
  148.         BEGIN
  149.           ss:=AddBackSlash(JustPathName(s))+sr.name;
  150.           Break;
  151.         END ELSE
  152.         BEGIN
  153.           ch:=sr.name[12];
  154.           ss:=AddBackSlash(JustPathName(s))+sr.name;
  155.           INC(ss[LENGTH(ss)]);
  156.           IF ss[LENGTH(ss)]>'9' THEN ss[LENGTH(ss)]:='0';
  157.         END;
  158.         FINDNEXT(sr);
  159.       END;
  160.       FindClose(sr);
  161.       IF ss='' THEN
  162.       BEGIN
  163.         ss:=s;
  164.         ss[LENGTH(ss)]:='0';
  165.       END;
  166.       EraseTruncatedBundles(ss);
  167.       CurrentBundle:=ss;
  168.     END;
  169.  
  170.   BEGIN
  171.     AddLog('!','Packing '+JustFileName(FName)+' to '+Address2Str(Via));
  172.     FindNodeInfo(NodesRec,Via);
  173.     an:=NodesRec.PackerType;
  174.     IF an=0 THEN an:=1;
  175.     ch:=Schedule.Stat;
  176.     IF ch=' ' THEN ch:='H' ELSE
  177.       IF ch='N' THEN ch:='F';
  178.     IF MarkNodeBusy(DestBusyFile,Dest) THEN
  179.     BEGIN
  180.       IF NOT CmpAdr(Via,Dest) THEN Flag:=MarkNodeBusy(ViaBusyFile,Via)
  181.                               ELSE Flag:=TRUE;
  182.       IF Flag THEN
  183.       BEGIN
  184.         NewPkt:=AddBackSlash(JustPathName(FName))+InventPktName;
  185.         ArcName:=CurrentBundle(Via);
  186.         IF RenameFile(FName,NewPkt) THEN
  187.         BEGIN
  188.           GetDir(0,OldDir);
  189.           ChangeDir(JustPathName(NewPkt));
  190.           IF ArcCommand(an,1,ArcName,JustFileName(NewPkt)) THEN
  191.           BEGIN
  192.             DeleteFile(NewPkt);
  193.             SendAFile(ArcName,Via,ch,STTrunc);
  194.           END
  195.           ELSE
  196.           BEGIN
  197.             RenameFile(NewPkt,FName);
  198.           END;
  199.           ChangeDir(OldDir);
  200.         END;
  201.         IF NOT CmpAdr(Via,Dest) THEN UnMarkNodeBusy(ViaBusyFile);
  202.       END;
  203.       UnMarkNodeBusy(DestBusyFile);
  204.     END;
  205.   END;
  206.  
  207.   PROCEDURE BundleNetMail;
  208.   VAR
  209.     Hold,Dir,Imp:BOOLEAN;
  210.     ts,s,ss,newname:STRING;
  211.     faf,ch,ch2:CHAR;
  212.     Year,Month,Day,dofw,hour,min,sec,sec100,i:WORD;
  213.     Len : LongInt;
  214.     h:MsgHdrType;
  215.     ph:TPktHeader;
  216.     p:POINTER;
  217.     Adr,Orig:TFidoAddress;
  218.     BusyFile,f:FILE;
  219.     pmh:TPktMsgHeader;
  220.     t:TNodeStat;
  221.  
  222.     FUNCTION IsOurPoint(Adr:TFidoAddress):BOOLEAN;
  223.     VAR
  224.       i:BYTE;
  225.     BEGIN
  226.       Adr.Point:=0;
  227.       IsOurPoint:=TRUE;
  228.       FOR i:=1 TO MaxAddresses DO
  229.         IF CmpAdr(Cfg.Addresses[i],Adr) THEN EXIT;
  230.       IsOurPoint:=FALSE;
  231.     END;
  232.  
  233.   BEGIN
  234.     FOR i:=1 TO GetHighestMsg(Cfg.MailScanner.NetMailDir) DO
  235.     BEGIN
  236.       IF ReadMsg(Cfg.MailScanner.NetMailDir,i,h,Len,p) THEN
  237.       BEGIN
  238.         IF h.attribute AND MsgSent=0 THEN
  239.         BEGIN
  240.           FindMsgAdr(h,p,Len,Orig,Adr);
  241.           IF NOT IsOurAddress(Adr) THEN
  242.           BEGIN
  243.             AddLog('#','Packing msg. #'+Long2Str(i)+' from '+Address2Str(Orig)+' to '+Address2Str(Adr));
  244.             FindNodeInfo(NodesRec,Adr);
  245.             IF Cfg.MailScanner.StripCrash AND (h.attribute AND MsgCrash<>0) AND
  246.                NOT (IsOurAddress(Orig)) THEN
  247.             BEGIN
  248.               ASM
  249.                 AND h.attribute,NOT MsgCrash
  250.               END;
  251.             END;
  252.             IF h.attribute AND MsgHold<>0 THEN ch:='H' ELSE
  253.               IF h.attribute AND MsgCrash<>0 THEN ch:='C' ELSE ch:='O';
  254.             IF ch='O' THEN
  255.             BEGIN
  256.               FindMsgKludges(p,Len,Dir,Imp,Hold);
  257.               IF Hold THEN ch:='H' ELSE
  258.                 IF Dir THEN ch:='D' ELSE
  259.                   IF Imp THEN ch:='I';
  260.             END;
  261.             IF ch<>'O' THEN ch2:=ch ELSE ch2:='F';
  262.             IF NOT IsOurPoint(Adr) AND (ch='C') THEN Adr.Point:=0;
  263.             IF MarkNodeBusy(BusyFile,Adr) THEN
  264.             BEGIN
  265.               ASSIGN(f,HoldFileName(Adr,TRUE)+ch+'UT'); FileMode:=ShareWrite+ShareDenyW;
  266.               RESET(f,1);
  267.               IF IORESULT<>0 THEN
  268.               BEGIN
  269.                 REWRITE(f,1);
  270.                 FillOutPktHeader(Cfg.Addresses[Cfg.MainAdrNum],Adr,ph);
  271.                 BLOCKWRITE(f,ph,SIZEOF(ph));
  272.               END
  273.               ELSE
  274.               BEGIN
  275.                 SEEK(f,FileSize(f)-1);
  276.               END;
  277.               { Write message here }
  278.               FILLCHAR(pmh,SizeOf(Pmh),0);
  279.               WITH pmh DO
  280.               BEGIN
  281.                 startmsg:=2;
  282.                 orignode:=h.orignode;
  283.                 destnode:=h.destnode;
  284.                 orignet:=h.orignet;
  285.                 destnet:=h.destnet;
  286.                 attr:=h.attribute;
  287.                 cost:=h.cost;
  288.                 MOVE(h.datetime,time,20);
  289.               END;
  290.               BLOCKWRITE(f,pmh,SizeOf(pmh));
  291.               s:=AsciiZ2Str(h.ToUser,36)+#0+AsciiZ2Str(h.FromUser,36)+#0+
  292.                  AsciiZ2Str(h.Subject,72)+#0;
  293.               BLOCKWRITE(f,s[1],LENGTH(s));
  294.               BLOCKWRITE(f,p^,len-1); { 24-09-95 }
  295.               s:=#0#0;
  296.               BLOCKWRITE(f,s[1],2);
  297.               CLOSE(f);
  298.               IF h.Attribute AND MsgFreq<>0 THEN
  299.               BEGIN
  300.                 s:=AsciiZ2Str(h.Subject,72)+' ';
  301.                 replace(s,'  ',' ',0);
  302.                 WHILE s<>'' DO
  303.                 BEGIN
  304.                   ss:=COPY(s,1,POS(' ',s)-1);
  305.                   DELETE(s,1,LENGTH(ss)+1);
  306.                   RequestAFile(ss,Adr,'');
  307.                 END;
  308.               END;
  309.               IF h.Attribute AND MsgFile<>0 THEN
  310.               BEGIN
  311.                 s:=AsciiZ2Str(h.Subject,72)+' ';
  312.                 CASE NodesRec.Flavor OF
  313.                   'N' : faf:='F';
  314.                   'C',
  315.                   'D',
  316.                   'I' : faf:=NodesRec.Flavor;
  317.                   ELSE  faf:='H';
  318.                 END;
  319.                 replace(s,'  ',' ',0);
  320.                 WHILE s<>'' DO
  321.                 BEGIN
  322.                   ss:=COPY(s,1,POS(' ',s)-1);
  323.                   DELETE(s,1,LENGTH(ss)+1);
  324.                   IF NOT IsOurAddress(Orig) THEN { Routed mail }
  325.                   BEGIN
  326.                     ts:='';
  327.                     FOR t:=nsUnknown TO nsPassWord DO
  328.                     BEGIN
  329.                       IF ExistFile(Cfg.Inbound[t]+JustFileName(ss)) THEN
  330.                       BEGIN
  331.                         ts:=Cfg.Inbound[t]+JustFileName(ss);
  332.                         Break;
  333.                       END;
  334.                     END;
  335.                     IF ts<>'' THEN
  336.                     BEGIN
  337.                       NewName:=Cfg.FwdFile.SecureDir+JustFileName(ss);
  338.                       CopyFile(ts,NewName,FALSE,TRUE);
  339.                       SendAFile(NewName,Adr,faf,1+BYTE(Cfg.MailScanner.KillFwdFiles));
  340.                     END;
  341.                   END
  342.                   ELSE
  343.                   BEGIN
  344.                     SendAFile(ss,Adr,ch2,stNothing);
  345.                   END;
  346.                 END;
  347.               END;
  348.               IF (h.attribute AND MsgKill<>0) OR
  349.                  (Cfg.MailScanner.NetMailBoard<>0) OR
  350.                  (NOT IsOurAddress(Orig)) THEN
  351.                 DeleteFile(Cfg.MailScanner.NetMailDir+Long2Str(i)+'.MSG')
  352.               ELSE
  353.               BEGIN
  354.                 h.attribute:=h.attribute OR MsgSent;
  355.                 WriteMsg(Cfg.MailScanner.NetMailDir,i,h,Len,p);
  356.               END;
  357.               UnMarkNodeBusy(BusyFile);
  358.             END;
  359.           END;
  360.         END;
  361.         FreeMemCheck(p,Len);
  362.       END;
  363.     END;
  364.   END;
  365.  
  366. BEGIN
  367.   BundleNetMail;
  368.   SchedFile.Open(StartPath+PoPScheduleFileName,SizeOf(TSchedule),FALSE);
  369.   IF SchedFile.IOResult=0 THEN
  370.   BEGIN
  371.     FINDFIRST(Cfg.Outbound+'.*',Directory,DirSr); { Parse all zones }
  372.     WHILE DOSERROR=0 DO
  373.     BEGIN
  374.       IF DirSr.Attr AND Directory<>0 THEN
  375.       BEGIN
  376.         IF DirSr.Name=JustFileName(Cfg.Outbound) THEN GlobZone:=cfg.Addresses[Cfg.MainAdrNum].Zone ELSE
  377.         BEGIN
  378.           p:=Copy(DirSr.Name,POS('.',DirSr.Name)+1,3);
  379.           Val('$'+p, GlobZone, io);
  380.         END;
  381.         ZoneOut:=HoldAreaNameMunge(GlobZone,False);
  382.  
  383.         FINDFIRST(ZoneOut+'????????.OUT',Archive,Sr);
  384.         WHILE DOSERROR=0 DO
  385.         BEGIN
  386.           p:=ZoneOut+sr.name;
  387.           FindDestNode(p,Dest,Via);
  388.           PackIt(p,Dest,via);
  389.           FINDNEXT(Sr);
  390.         END;
  391.         FindClose(Sr);
  392.  
  393.         FINDFIRST(ZoneOut+'????????.PNT',Directory,PntSr);
  394.         WHILE DOSERROR=0 DO
  395.         BEGIN
  396.           FINDFIRST(ZoneOut+PntSr.name+'\????????.OUT',Archive,Sr);
  397.           IF PntSr.Attr AND Directory<>0 THEN
  398.           BEGIN
  399.             WHILE DOSERROR=0 DO
  400.             BEGIN
  401.               p:=ZoneOut+PntSr.name+'\'+sr.name;
  402.               FindDestNode(p,Dest,Via);
  403.               PackIt(p,Dest,via);
  404.               FINDNEXT(Sr);
  405.             END;
  406.             FindClose(Sr);
  407.           END;
  408.  
  409.           FINDNEXT(PntSr);
  410.         END;
  411.         FindClose(PntSr);
  412.       END;
  413.       FINDNEXT(DirSr);
  414.     END;
  415.     FindClose(DirSr);
  416.     SchedFile.Close;
  417.   END;
  418. END;
  419.  
  420. END.
  421.